home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / gfx / show / PlayKiSS0_88.lha / PlayKiss / src / maptokcf.e < prev    next >
Text File  |  1994-10-30  |  1KB  |  70 lines
  1.  
  2. MODULE 'dos/dos'
  3.  
  4. DEF rdarg
  5. DEF argarray[11]:LIST
  6. DEF source[150]:STRING
  7. DEF dest[150]:STRING
  8. DEF dummy[250]:STRING
  9. DEF fh1,fh2,res,i
  10. DEF red,grn,blu
  11. DEF buffer
  12.  
  13. PROC main() HANDLE
  14.     buffer:=New(1000)
  15.     argarray[0]:=0
  16.     argarray[1]:=0
  17.     rdarg:=ReadArgs('FROM/A,TO',argarray,0)
  18.  
  19.     IF argarray[0]<>NIL
  20.         StrCopy(source,argarray[0],ALL)
  21.     ENDIF
  22.     IF argarray[1]<>NIL
  23.         StrCopy(dest,argarray[1],ALL)
  24.         IF StrLen(dest)<1
  25.             StrCopy(dest,source,ALL)
  26.             i:=InStr(UpperStr(dest),'.MAP')
  27.             StrCopy(dest,source,i)
  28.             StrAdd(dest,'.CEL',ALL)
  29.         ENDIF
  30.     ENDIF
  31.  
  32. WriteF('Translating "\s" to "\s"...\n',source,dest)
  33.  
  34.     IF rdarg>0
  35.         IF (fh1:=Open(source,MODE_OLDFILE))
  36.             IF (fh2:=Open(dest,MODE_NEWFILE))
  37.  
  38.                 Read(fh1,buffer,12)  -> P6.16.1.255.
  39.                 res:=Read(fh1,buffer,3*16)
  40.                 FOR i:=0 TO 15
  41.                     IF res<0 THEN Raise("DOS")
  42.  
  43.                     red:=Shr(Char(buffer+(i*3)),4)
  44.                     grn:=Shr(Char(buffer+(i*3)+1),4)
  45.                     blu:=Shr(Char(buffer+(i*3)+2),4)
  46.  
  47.                     PutChar(buffer+(i*2),(Shl(red,4) OR blu))
  48.                     PutChar(buffer+(i*2)+1,grn)
  49.  
  50.                 ENDFOR
  51.                 FOR i:=0 TO 9
  52.                     res:=Write(fh2,buffer,32)
  53.                     IF res<0 THEN Raise("DOS")
  54.                 ENDFOR
  55.             ELSE
  56.                 Raise("DOS")
  57.             ENDIF
  58.         ELSE
  59.             Raise("DOS")
  60.         ENDIF
  61.     ELSE
  62.         Raise("DOS")
  63.     ENDIF
  64. EXCEPT DO
  65.     IF fh1 THEN Close(fh1)
  66.     IF fh2 THEN Close(fh2)
  67.     IF buffer THEN Dispose(buffer)
  68.     IF exception THEN WriteF('An error occured.\n\n')
  69. ENDPROC
  70.